home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / win-os2.swg / 0026_Window Memory Stream.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-02-15  |  4.8 KB  |  156 lines
  1. {
  2.         Useful for transferring  objects which have been registered to the clipboard or any global memory situation.
  3.         Also could be used to make a copy of any streamable object. Merely stream the object to memory and then
  4.         re-instantiate a new object through the use of a TStream.Get. Solves the
  5.         problem of passing objects to another program because it removes any method pointer info.
  6.  
  7.         NOTE: This works only for streams which are not larger than 64K. In order
  8.                                 to make this work for larger streams you have to ensure that your
  9.                                 writes and puts (and gets and reads...) don't straddle each 64K boundary.
  10.                                 I haven't added the pointer math to this unit yet.
  11. }
  12.  
  13. { Author Robert Warren CIS ID 70303,537 }
  14.  
  15. Unit MemStream;
  16.  
  17. interface
  18.  
  19.         Uses WinTypes,WinProcs, WObjects;
  20.  
  21.         type
  22.  
  23.                 PMemStream = ^TMemStream;
  24.                 TMemStream = object(TStream)
  25.  
  26.                                 Handle: Word;
  27.                                 Address: Pointer;
  28.                                 Size: Longint;       { allocated size }
  29.                                 Position: Longint;   { current position in stream }
  30.                                 AllocFlags: LongInt; { flags required when allocating / reallocating }
  31.                                 FreeMemory: Boolean; { Flag indicating whether to free global
  32.                                                                                                                          memory when disposing of object }
  33.  
  34.                         constructor Init(AllocSize: Longint; Flags: LongInt; FreeMem: Boolean);
  35.                         constructor InitWithHandle(aHandle: THandle; Flags: LongInt; FreeMem: Boolean);
  36.                         destructor Done; virtual;
  37.                         function GetPos: Longint; virtual;
  38.                         procedure Grow(howMuch: LongInt); virtual;
  39.                         function GetSize: Longint; virtual;
  40.                         procedure Read(var Buf; Count: Word); virtual;
  41.                         procedure Write(var Buf; Count: Word); virtual;
  42.                         procedure Seek(Pos: Longint); virtual;
  43.                         procedure Truncate; virtual;
  44.                 end;
  45.  
  46. implementation
  47.  
  48. {
  49.  creates a memory stream of given size using the flags. The FreeMem argument
  50.  is used to determine whether to delete the global block of memory when the
  51.  object is disposed of. Sometime you don't want to delete the block if for
  52.  example it has been placed in the clipboard or passed using DDE.
  53. }
  54. constructor TMemStream.Init(AllocSize: Longint; Flags: LongInt;FreeMem: Boolean);
  55. begin
  56.  TStream.Init;
  57.  Handle:=GlobalAlloc( Flags, AllocSize);
  58.  Address:=GlobalLock(Handle); { so much for real mode }
  59.  Size:=AllocSize;
  60.  Position:=0;
  61.  FreeMemory:= FreeMem;
  62. end;
  63.  
  64. {
  65.  same as above but allows for the creation of a object given an already
  66.  allocated memory block. Perhaps some data FROM a clipboard
  67. }
  68. constructor TMemStream.InitWithHandle(aHandle: THandle; Flags: LongInt;FreeMem: Boolean);
  69. begin
  70.  TStream.Init;
  71.  Size:=GlobalSize(Handle);
  72.  Address:=GlobalLock(Handle);
  73.  Position:=0;
  74.  FreeMemory:= FreeMem;
  75. end;
  76.  
  77.  
  78. destructor TMemStream.Done;
  79. begin
  80.  TStream.Done;
  81.  GlobalUnlock(Handle);
  82.  If FreeMemory then GlobalFree(Handle);
  83. end;
  84.  
  85. function TMemStream.GetPos: LongInt;
  86. begin
  87.         GetPos:=Position;
  88. end;
  89.  
  90. function TMemStream.GetSize: LongInt;
  91. begin
  92.         GetSize:=Size;
  93. end;
  94.  
  95.  
  96. procedure TMemStream.Read(var Buf; Count: Word);
  97. var
  98.  varAddress: PChar;
  99.  stAddress: PChar;
  100.  i: LongInt;
  101. begin
  102.  varAddress:=@Buf;
  103.  stAddress:=PChar(MakeLong(Position+LoWord(LongInt(Address)),HiWord(LongInt(Address))));
  104.  for i:=0 to Count -1 do
  105.          varAddress[i]:=stAddress[i];
  106.  inc(Position,Count);
  107. end;
  108.  
  109. procedure TMemStream.Grow(HowMuch: LongInt);
  110. begin
  111.  GlobalUnlock(Handle);
  112.  Inc(Size,HowMuch);
  113.  GlobalRealloc(Handle, Size, AllocFlags);
  114.  GlobalLock(Handle);
  115. end;
  116.  
  117. procedure TMemStream.Write(var Buf; Count: Word);
  118. var
  119.  varAddress: PChar;
  120.  stAddress: PChar;
  121.  i: LongInt;
  122.  growSize: Integer;
  123. begin
  124.  
  125.  if Position + Count >= Size then
  126.          begin
  127.                 if count < 1023
  128.                          then growSize:=1024
  129.                          else growSize:=count + 1;
  130.  
  131.                 Grow(growSize);
  132.          end;
  133.  
  134.  varAddress:=@Buf;
  135.  stAddress:=PChar(MakeLong(Position+LoWord(LongInt(Address)),HiWord(LongInt(Address))));
  136.  for i:=0 to Count -1 do
  137.          stAddress[i]:=varAddress[i];
  138.  inc(Position,Count);
  139. end;
  140.  
  141. procedure TMemStream.Seek(Pos: Longint);
  142. begin
  143.  Position:=Pos;
  144. end;
  145.  
  146. procedure TMemStream.Truncate;
  147. begin
  148.         GlobalUnlock(Handle);
  149.         GlobalReAlloc(Handle,Position,AllocFlags);
  150.         Address:=GlobalLock(Handle);
  151.         Size:=Position;
  152. end;
  153.  
  154. end.
  155.  
  156.